home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1286.arc / BNCHMARK.ADA / FORTUNE.ADA < prev    next >
Text File  |  1986-09-06  |  3KB  |  124 lines
  1. with RANDOM; use RANDOM;
  2. with TEXT_IO; use TEXT_IO;
  3.  
  4. procedure FORTUNE is
  5.  
  6.     --
  7.     -- Fortune cookie program
  8.     --     Author: Bruce A. Bergman, Aug 1986
  9.     --     These routines are released to the public domain for personal,
  10.     --     non-commercial purposes provided authorship remains unchanged.
  11.     --     Source available from Mark Petersen's Alpo-Net FIDO board at
  12.     --     (619) 741-3412, 300/1200/2400 8,N,1
  13.     --
  14.  
  15.  
  16.     package IIO is new INTEGER_IO(integer); use IIO;
  17.  
  18.     ------------------------------
  19.     -- declarations
  20.     ------------------------------
  21.  
  22.     type var_string is record
  23.         image  : string (1..255);
  24.         length : natural;
  25.     end record;
  26.  
  27.     cookie            : natural;
  28.     cookie_jar        : file_type;
  29.     fortune           : var_string;
  30.     number_of_cookies : natural;
  31.  
  32.     ------------------------------
  33.     -- PUT_FORTUNE
  34.     ------------------------------
  35.  
  36.     --
  37.     -- Format fortune for 80 column screen.
  38.     --
  39.  
  40.     procedure PUT_FORTUNE(fortune : in string) is
  41.  
  42.         last : natural := fortune'length;    -- find end
  43.  
  44.     begin
  45.  
  46.         --
  47.         -- Check to see if fortune longer than screen
  48.         --
  49.  
  50.         if last > 78 then
  51.             last := 78;
  52.  
  53.             --
  54.             -- Search backwards until we find a space,
  55.             -- then cut at that point (keeps fortune readable).
  56.             --
  57.  
  58.             while (fortune(last) /= ' ') and (last > 1) loop
  59.                 last := last - 1;
  60.             end loop;
  61.  
  62.             --
  63.             -- Display it on screen.
  64.             --
  65.  
  66.             put_line(fortune(1..last));
  67.             put_line(fortune(last+1..fortune'length));
  68.         else
  69.  
  70.             --
  71.             -- Fortune doesn't need to be split.
  72.             --
  73.  
  74.             put_line(fortune);
  75.         end if;
  76.     end PUT_FORTUNE;
  77.  
  78. begin
  79.  
  80.     --
  81.     -- Open cookie jar.
  82.     -- Find out how many cookies inside.
  83.     --
  84.  
  85.     open(cookie_jar, in_file, "cookie.jar");
  86.     get(cookie_jar, number_of_cookies);
  87.  
  88.     --
  89.     -- Pick a cookie at random (add one so we don't
  90.     -- pick zero cookies).
  91.     --
  92.  
  93.     cookie := random_number(number_of_cookies) + 1;
  94.  
  95.     --
  96.     -- Sort through the pile until we find the
  97.     -- exact cookie we are looking for.
  98.     --
  99.  
  100.     for i in 1..cookie loop
  101.         get_line(cookie_jar, fortune.image, fortune.length);
  102.     end loop;
  103.  
  104.     --
  105.     -- Close cookie jar.
  106.     --
  107.  
  108.     close(cookie_jar);
  109.  
  110.     --
  111.     -- Display fortune.
  112.     --
  113.  
  114.     put_fortune(fortune.image(1..fortune.length));
  115.  
  116. exception
  117.     when name_error =>       -- couldn't find cookie jar
  118.         put_line("Sorry, your cookie jar is empty!");
  119.  
  120.     when numeric_error =>    -- error choosing a cookie
  121.         put_line("Sorry, the cookie jar is broken!");
  122.  
  123. end FORTUNE;
  124.